home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 007 / tbbyte.arc / PILOT1.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1985-08-14  |  4.8 KB  |  198 lines
  1. {PASCAL VERSION OF WADUZITDO}
  2. PROGRAM WADUZITDO;
  3.  
  4.   CONST PZ=5000; BS=127; EOL=10;STRLEN=80;
  5.  
  6.   TYPE STR=STRING[STRLEN];
  7.  
  8.   VAR LOC,LST,I,E,C : INTEGER;
  9.       LCHR,FLG,CBUF,CH,CURS,CBS,CEOL : CHAR;
  10.       S : STR;
  11.       FLAG, RUN, DONE: BOOLEAN;
  12.       PROG : ARRAY[1..PZ] OF CHAR;
  13.  
  14.   PROCEDURE CHIN;
  15.     BEGIN
  16.       IF FLAG THEN
  17.         BEGIN
  18.           E := 1;
  19.           WRITE (CURS);
  20.           READ(S);
  21.           FLAG := FALSE
  22.         END;
  23.       IF E > LENGTH(S) THEN
  24.          BEGIN
  25.            E := 1;
  26.            WRITELN;
  27.            WRITE (CURS);
  28.            READ (S);
  29.            CBUF := CHR(EOL)
  30.          END
  31.       ELSE
  32.          BEGIN
  33.            C := ORD(S[E]);
  34.            IF C = $1B THEN
  35.               BEGIN
  36.                 DONE := TRUE;
  37.                 C := $20
  38.               END;
  39.            CH := CHR(C);
  40.            CBUF := CH;
  41.            E := E + 1
  42.          END;
  43. END;
  44.  
  45.   PROCEDURE CHOUT;
  46.     BEGIN
  47.       IF CBUF = CHR(EOL) THEN
  48.         WRITELN
  49.       ELSE
  50.         WRITE (CBUF);
  51.     END;
  52.  
  53.   PROCEDURE NEWLINE;
  54.     BEGIN
  55.       WRITELN;
  56.     END;
  57.  
  58.   PROCEDURE LIST;
  59.   VAR I: INTEGER;
  60.     BEGIN
  61.       I := 0;
  62.       LOC := LOC - 1;
  63.       REPEAT
  64.         CBUF := PROG [LOC];
  65.         LOC := LOC + 1;
  66.         I := I + 1;
  67.         CHOUT
  68.       UNTIL (I>64) OR (CBUF=CEOL);
  69.       NEWLINE
  70.     END;
  71.  
  72.   PROCEDURE LISTALL;
  73.     VAR J : INTEGER;
  74.     BEGIN
  75.       J := 0;
  76.       LOC := 1;
  77.       REPEAT
  78.         LIST;
  79.         J := J + 1
  80.       UNTIL (PROG[LOC+1] = 'S') OR (J = 10);
  81.       NEWLINE
  82.     END;
  83.  
  84.   PROCEDURE EXECUTE;
  85.  
  86.     BEGIN
  87.       LOC :=1;
  88.       CURS := '#';
  89.       REPEAT
  90.         CBUF := PROG[LOC];
  91.         IF CBUF < '*' THEN
  92.            CBUF := '*';
  93.         IF NOT (CBUF IN ['*','Y','N','A','M','J','T','S']) THEN
  94.            LIST
  95.         ELSE
  96.            CASE CBUF OF
  97.            '*': LOC := LOC+1;
  98.            'Y': IF CBUF = FLG THEN
  99.                          LOC := LOC + 1
  100.                       ELSE
  101.                          REPEAT
  102.                            CBUF := PROG[LOC];
  103.                            WRITE (CBUF);
  104.                            LOC := LOC + 1
  105.                          UNTIL CBUF = CEOL;
  106.  
  107.            'N': IF CBUF = FLG THEN
  108.                          LOC := LOC + 1
  109.                       ELSE
  110.                          REPEAT
  111.                            CBUF := PROG[LOC];
  112.                            WRITE (CBUF);
  113.                            LOC := LOC + 1
  114.                          UNTIL CBUF = CEOL;
  115.            'A' : BEGIN
  116.                    LST := LOC;
  117.                    CHIN;
  118.                    LCHR := CBUF;
  119.                    NEWLINE;
  120.                    LOC := LOC + 2
  121.                  END;
  122.            'M' : BEGIN
  123.                    IF LCHR = PROG[LOC+2] THEN
  124.                       FLG := 'Y'
  125.                    ELSE
  126.                       FLG := 'N';
  127.                    LOC := LOC + 3
  128.                  END;
  129.            'J' : IF PROG[LOC+2] = '0' THEN
  130.                     LOC := LST
  131.                  ELSE
  132.                     BEGIN
  133.                       I := ORD(PROG[LOC+2])-48;
  134.                       REPEAT
  135.                         LOC := LOC + 1;
  136.                         IF PROG[LOC] = '*' THEN
  137.                            I := I - 1;
  138.                       UNTIL I = 0
  139.                     END;
  140.            'T' : BEGIN
  141.                    LOC := LOC + 2;
  142.                    LIST
  143.                  END;
  144.            'S' : BEGIN
  145.                    DONE := TRUE;
  146.                    LOC := 1
  147.                  END
  148.          END
  149.      UNTIL DONE
  150.   END;
  151.  
  152.   begin
  153.     CBS := CHR(BS);
  154.     CEOL := CHR(EOL);
  155.     CBUF := '\';
  156.     FLAG := TRUE;
  157.     RUN := TRUE;
  158.     while RUN do
  159.       begin
  160.         CURS := '*';
  161.         if CBUF = '\' then
  162.            LOC := 1
  163.         else if CBUF = CBS then
  164.                 LOC := LOC - 1
  165.         else if CBUF = '/' then
  166.                 LIST
  167.         else if CBUF = '=' then
  168.                 LISTALL
  169.         else if CBUF = '$' then
  170.                 BEGIN
  171.                   DONE := FALSE;
  172.                   EXECUTE
  173.                 END
  174.         else if CBUF = '!' then
  175.                 RUN := FALSE
  176.         else if CBUF = '%' then
  177.                 begin
  178.                   I := 0;
  179.                   while (I<64) and (PROG[LOC] <> CEOL) do
  180.                     begin
  181.                       PROG[LOC] := CHR(0);
  182.                       LOC := LOC + 1
  183.                     end;
  184.                   PROG[LOC] := CEOL;
  185.                   LOC := LOC + 1
  186.                 end
  187.         else begin
  188.                PROG[LOC] := CBUF;
  189.                LOC := LOC + 1
  190.              end;
  191.         if RUN then
  192.           begin
  193.             CURS := '*';
  194.             CHIN
  195.           end
  196.      END
  197.     END.
  198.